home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#46 (Jul 89)
/
Window Menu Code
/
Window.p
< prev
next >
Wrap
Text File
|
1989-01-19
|
19KB
|
810 lines
(*******************************************************************
Window.p
Demo of a dynamic Window menu.
(c) 1988, by Clifford Story & Attic Software
*******************************************************************)
program Window;
(******************************************************************)
uses memtypes, quickdraw, osintf, toolintf, packintf, Common;
(*******************************************************************
Program constants:
*******************************************************************)
const
applenum = 1001;
aboutitem = 1;
atticitem = 2;
filenum = 1002;
newitem = 1;
closeitem = 2;
quititem = 4;
editnum = 1003;
undoitem = 1;
cutitem = 3;
copyitem = 4;
pasteitem = 5;
clear = 6;
windnum = 1004;
zoomitem = 1;
messagedialog = 1001;
windownum = 1001;
zoomwindnum = 1002;
hoffset = 32;
voffset = 20;
(*******************************************************************
Program types:
*******************************************************************)
type
datarecord = record
dummy : WindowRecord;
recordid : integer;
next : integer;
end;
datapointer = ^datarecord;
(*******************************************************************
Program variables:
*******************************************************************)
var
APPLEMENU : MenuHandle;
FILEMENU : MenuHandle;
EDITMENU : MenuHandle;
WINDOWMENU : MenuHandle;
MENUHEIGHT : integer;
DRAGRECT : Rect;
GROWRECT : Rect;
SCREENRECT : Rect;
WINDOWS : array [0..17] of datarecord;
FREE : integer;
OLDROM : logical;
COLUMNS : integer;
ROWS : integer;
WINDOWCOUNT : integer;
DONE : logical;
JEVENT : logical;
MAINEVENT : EventRecord;
(******************************************************************)
procedure _datainit; external;
(******************************************************************)
{$R-}
{$SC+}
(******************************************************************)
procedure panic;
begin
ExitToShell;
end;
(******************************************************************)
procedure centerdialog(thetype : OSType; theid : integer);
var
thehandle : AlertTHndl;
begin
thehandle := AlertTHndl(GetResource(thetype, theid));
HLock(Handle(thehandle));
with thehandle^^ do begin
with boundsRect do
SetRect(boundsRect, 0, 0, right - left, bottom - top);
with screenBits.bounds, boundsRect.botright do
OffsetRect(boundsRect, (right - left - h) div 2,
(bottom - top - v + 2 * MENUHEIGHT) div 3);
end;
HUnlock(Handle(thehandle));
end;
(******************************************************************)
procedure initmac;
begin
MaxApplZone;
InitGraf(@thePort);
InitFonts;
InitWindows;
InitCursor;
InitMenus;
TEInit;
InitDialogs(@panic);
UnloadSeg(@_datainit);
end;
(******************************************************************)
procedure setupmenus;
begin
APPLEMENU := GetMenu(applenum);
AddResMenu(APPLEMENU, 'DRVR');
InsertMenu(APPLEMENU, 0);
FILEMENU := GetMenu(filenum);
InsertMenu(FILEMENU, 0);
EDITMENU := GetMenu(editnum);
InsertMenu(EDITMENU, 0);
WINDOWMENU := GetMenu(windnum);
InsertMenu(WINDOWMENU, 0);
DrawMenuBar;
end;
(*******************************************************************
initglobals
-----------
Initialize all global variables. This is all standard stuff;
note, however, that I'm going to keep track of the ROM version,
since (1) the standard WDEF can't handle zoom windows on the
64K ROM, so I want to open standard document windows instead;
and (2) I don't want to enable the “Zoom Front Window” command
on the 64K ROM.
*******************************************************************)
procedure initglobals;
var
index : integer;
begin
for index := 1 to 10 do
MoreMasters;
OLDROM := BitTst(Ptr(rom85), 0);
if OLDROM then
MENUHEIGHT := 20
else
MENUHEIGHT := shortpointer(mbarheight)^;
if GetResource('PACK', 0) = nil then
JEVENT := false
else
JEVENT := (NGetTrapAddress($A860, ToolTrap)
<> NGetTrapAddress($A89F, ToolTrap));
with screenBits.bounds do begin
SetRect(DRAGRECT, left + 5, top + MENUHEIGHT + 5,
right - 5, bottom - 25);
SetRect(GROWRECT, 160, 100, right - left - 10,
bottom - top - MENUHEIGHT - 10);
SetRect(SCREENRECT, left + 5, top + MENUHEIGHT + 25,
right - 5, bottom - 5);
COLUMNS := 1 + ((right - left - 330) div hoffset);
ROWS := 1 + ((bottom - top - MENUHEIGHT - 230) div voffset);
end;
for index := 0 to 17 do
with WINDOWS[index] do begin
recordid := index;
next := index + 1;
end;
WINDOWS[17].next := -1;
FREE := 0;
WINDOWCOUNT := 0;
DONE := false;
end;
(*******************************************************************
clickapplemenu
--------------
This may not be new to you but it is to me! Instead of using an
alert for the “About...” box, I'm using a picture. First I open
a new GrafPort, then draw the picture in its center. Note that
I must re-draw the windows after the user dismisses the screen,
using PaintBehind.
*******************************************************************)
procedure clickapplemenu(theitem : integer);
var
itemname : Str255;
savedport : GrafPtr;
dummy : integer;
newport : GrafPort;
thepicture : PicHandle;
therect : Rect;
begin
if theitem > 3 then begin
GetItem(APPLEMENU, theitem, itemname);
GetPort(savedport);
dummy := OpenDeskAcc(itemname);
SetPort(savedport);
end else if theitem < 3 then begin
InitCursor;
GetPort(savedport);
OpenPort(@newport);
SetPort(@newport);
thepicture := PicHandle(GetResource('PICT',
1000 + theitem));
with thepicture^^.picFrame do
SetRect(therect, 0, 0, right - left, bottom - top);
with screenBits.bounds, therect.botright do
OffsetRect(therect, (right - left - h) div 2,
(bottom - top - v) div 3);
DrawPicture(thepicture, therect);
repeat until Button;
ClosePort(@newport);
EnableItem(EDITMENU, 0);
DrawMenuBar;
PaintBehind(WindowPeek(FrontWindow),
RgnHandle(longpointer(grayrgn)^));
SetPort(savedport);
FlushEvents(everyEvent, 0);
end;
end;
(******************************************************************)
procedure placewindow(thewindow : WindowPtr);
var
left : integer;
top : integer;
begin
left := 5 + hoffset * (WINDOWCOUNT mod COLUMNS);
top := 5 + MENUHEIGHT
+ voffset * (1 + (WINDOWCOUNT mod ROWS));
MoveWindow(thewindow, left, top, true);
end;
(*******************************************************************
donew
-----
This routine creates a new window, choosing the window resource
according to the ROM version. The refcon is set to zero, to
indicate that the window is unzoomed. The new window will be
automatically added to the Window menu but the size of the menu
rectangle must be recalculated.
Since the Window menu can't scroll, it can show only 18 windows
(20 items, minus the zoom command and the dividing line). So I
limit the program to those 18. Since the program is limited to
18 windows, I allocate a global array of extended WindowRecords
called WINDOW to avoid fragmenting the heap. Each WindowRecord
is extended to include two integer fields: the array index of
the record, and the index of the next record in the free list
(which is used only if the record is not in use). There's a
global called FREE that holds the index of the first free record.
When I open a window, I pass the address of the first free record
for the “wStorage” argument of GetNewWindow. Then I set FREE to
point to the next free record. The last record points to -1, so
when all the records are in use, FREE = -1, and I put up an alert.
(This is a lot easier to code than to explain...)
*******************************************************************)
procedure donew;
label
100;
var
dummy : integer;
windowtype : integer;
thewindow : WindowPtr;
thestring : Str255;
begin
if FREE < 0 then begin
InitCursor;
centerdialog('ALRT', messagedialog);
dummy := Alert(messagedialog, nil);
goto 100;
end;
if OLDROM then
windowtype := windownum
else
windowtype := zoomwindnum;
thewindow := GetNewWindow(windowtype,
@WINDOWS[FREE], WindowPtr(-1));
placewindow(thewindow);
WINDOWCOUNT := WINDOWCOUNT + 1;
NumToString(WINDOWCOUNT, thestring);
SetWTitle(thewindow,
concat('Window Without a Title #', thestring));
ShowWindow(thewindow);
CalcMenuSize(WINDOWMENU);
FREE := WINDOWS[FREE].next;
100: end;
(*******************************************************************
doclose
-------
Here I close a window; if it is an application window, it is
automatically deleted from the menu but the menu dimensions must
be recalculated.
Now I must return the WindowRecord to the free list. FREE
points to the first free record; I just set the newly-freed
record to point to that record, and set FREE to point to the
N.F.R. (newly-freed record).
I just put in that array-of-WindowRecord, free-list stuff this
very morning, and I'm really taken with it. Gonna have to
re-write all my old stuff...
*******************************************************************)
procedure doclose(thepeek : WindowPeek);
begin
if thepeek^.windowkind < 0 then
CloseDeskAcc(thepeek^.windowkind)
else begin
CloseWindow(WindowPtr(thepeek));
with datapointer(thepeek)^ do begin
next := FREE;
FREE := recordid;
end;
CalcMenuSize(WINDOWMENU);
end;
end;
(******************************************************************)
procedure doquit;
var
thelong : longpointer;
thepeek : WindowPeek;
begin
thelong := longpointer(windowlist);
thepeek := WindowPeek(thelong^);
while thepeek <> nil do begin
doclose(thepeek);
thepeek := thepeek^.nextwindow;
end;
DONE := true;
end;
(******************************************************************)
procedure clickfilemenu(theitem : integer);
begin
case theitem of
newitem : donew;
closeitem : doclose(WindowPeek(FrontWindow));
quititem : doquit;
end;
end;
(*******************************************************************
zoomthewindow
-------------
This routine zooms the window. If the refcon is zero, then the
window is in an unzoomed condition and should be zoomed out.
Otherwise, the window is at full screen and should be zoomed in.
*******************************************************************)
procedure zoomthewindow(thewindow : WindowPtr);
begin
if GetWRefCon(thewindow) = 0 then begin
ZoomWindow(thewindow, inZoomOut, true);
SetWRefCon(thewindow, 1);
end else begin
ZoomWindow(thewindow, inZoomIn, true);
SetWRefCon(thewindow, 0);
end;
end;
(*******************************************************************
clickwindowmenu
---------------
If the “Zoom Front Window” command is selected, then call
“zoomthewindow” to do the zooming and update the refcon.
Otherwise, walk the window list to find the window desired and
select it. This won't be the nth window but rather the nth
application window.
*******************************************************************)
procedure clickwindowmenu(theitem : integer);
var
thewindow : WindowPeek;
begin
if theitem = 1 then
zoomthewindow(FrontWindow)
else if theitem > 2 then begin
theitem := theitem - 2;
thewindow := WindowPeek(longpointer(windowlist)^);
while (not thewindow^.visible)
or (thewindow^.windowkind <> userKind) do
thewindow := thewindow^.nextwindow;
while theitem > 1 do begin
theitem := theitem - 1;
repeat
thewindow := thewindow^.nextwindow;
until thewindow^.visible
and (thewindow^.windowkind = userKind);
end;
SelectWindow(WindowPtr(thewindow));
end;
end;
(*******************************************************************
checkmenu
---------
This routine is called just before MenuSelect or MenuKey, to
make sure the menu items are appropriately enabled or disabled.
Note that the “Zoom Front Window” item on the Window menu is
never enabled on the 64K ROM.
*******************************************************************)
procedure checkmenu(thewindow : WindowPeek);
begin
DisableItem(EDITMENU, 0);
DisableItem(WINDOWMENU, zoomitem);
if thewindow = nil then
DisableItem(FILEMENU, closeitem)
else begin
if thewindow^.windowkind <> userKind then
EnableItem(EDITMENU, 0)
else if not OLDROM then
EnableItem(WINDOWMENU, zoomitem);
EnableItem(FILEMENU, closeitem);
end;
end;
(******************************************************************)
procedure clickinmenu;
var
choice : long;
begin
checkmenu(WindowPeek(FrontWindow));
choice := MenuSelect(MAINEVENT.where);
case HiWord(choice) of
applenum : clickapplemenu(LoWord(choice));
filenum : clickfilemenu(LoWord(choice));
editnum : if SystemEdit(LoWord(choice) - 1) then;
windnum : clickwindowmenu(LoWord(choice));
end;
HiliteMenu(0);
end;
(*******************************************************************
clickindrag
-----------
A drag will take the window out of full-zoom position if it was
in it, so clear the refcon.
*******************************************************************)
procedure clickindrag(thewindow : WindowPtr);
begin
DragWindow(thewindow, MAINEVENT.where, DRAGRECT);
SetWRefCon(thewindow, 0);
end;
(*******************************************************************
clickingrow
-----------
Growing the window will take it out of full-zoom position if it
was in it, so clear the refcon afterwards.
*******************************************************************)
procedure clickingrow(thewindow : WindowPtr);
var
newsize : long;
begin
newsize := GrowWindow(thewindow, MAINEVENT.where, GROWRECT);
if newsize <> 0 then begin
InvalRect(thewindow^.portRect);
SizeWindow(thewindow, LoWord(newsize), HiWord(newsize), true);
SetWRefCon(thewindow, 0);
end;
end;
(******************************************************************)
procedure clickingoaway(thewindow : WindowPtr);
begin
if TrackGoAway(thewindow, MAINEVENT.where) then
doclose(WindowPeek(thewindow));
end;
(*******************************************************************
clickinzoom
-----------
Instead of calling ZoomWindow directly, I'm going to call an
intermediate routine (discussed above) to keep track of whether
the window is zoomed in or out.
*******************************************************************)
procedure clickinzoom(thewindow : WindowPtr; thezoom : integer);
begin
if TrackBox(thewindow, MAINEVENT.where, thezoom) then
zoomthewindow(thewindow);
end;
(******************************************************************)
procedure aclick;
var
location : integer;
thewindow : WindowPtr;
begin
location := FindWindow(MAINEVENT.where, thewindow);
case location of
inDesk : SysBeep(1);
inMenuBar : clickinmenu;
inSysWindow : SystemClick(MAINEVENT, thewindow);
inContent : SelectWindow(thewindow);
inDrag : clickindrag(thewindow);
inGrow : clickingrow(thewindow);
inGoAway : clickingoaway(thewindow);
inZoomIn : clickinzoom(thewindow, inZoomIn);
inZoomOut : clickinzoom(thewindow, inZoomOut);
end;
end;
(******************************************************************)
procedure akey;
var
charcode : integer;
choice : long;
begin
if BitAnd(MAINEVENT.modifiers, cmdKey) <> 0 then begin
charcode := BitAnd(MAINEVENT.message, charCodeMask);
checkmenu(WindowPeek(FrontWindow));
choice := MenuKey(chr(charcode));
if choice <> 0 then begin
case HiWord(choice) of
applenum : clickapplemenu(LoWord(choice));
filenum : clickfilemenu(LoWord(choice));
editnum : if SystemEdit(LoWord(choice) - 1) then;
windnum : clickwindowmenu(LoWord(choice));
end;
HiliteMenu(0);
end;
end;
end;
(******************************************************************)
procedure anactivate(thewindow : WindowPtr);
var
savedport : GrafPtr;
begin
SetPort(thewindow);
DrawGrowIcon(thewindow);
end;
(******************************************************************)
procedure anupdate(thewindow : WindowPtr);
var
savedport : GrafPtr;
begin
GetPort(savedport);
SetPort(thewindow);
BeginUpdate(thewindow);
ClipRect(thewindow^.portRect);
EraseRect(thewindow^.portRect);
DrawGrowIcon(thewindow);
EndUpdate(thewindow);
SetPort(savedport);
end;
(******************************************************************)
procedure mainloop;
var
dummy : logical;
begin
repeat
if JEVENT then
dummy := waitnextevent(everyEvent, MAINEVENT,
GetCaretTime, nil)
else begin
SystemTask;
dummy := GetNextEvent(everyEvent, MAINEVENT);
end;
if dummy then begin
case MAINEVENT.what of
mouseDown : aclick;
keyDown : akey;
activateEvt : anactivate(WindowPtr(MAINEVENT.message));
updateEvt : anupdate(WindowPtr(MAINEVENT.message));
end;
end;
until DONE;
end;
(******************************************************************)
begin
initmac;
setupmenus;
initglobals;
mainloop;
end.
(******************************************************************)
